home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 4
/
Apprentice-Release4.iso
/
Languages
/
Mops 2.7
/
Mops ƒ
/
String
< prev
next >
Wrap
Text File
|
1995-02-25
|
6KB
|
267 lines
\ String class.
cr .( loading String...)
\ This class is changed radically from Neon! We now keep two offsets into a string
\ - POS and LIM. POS marks the "current" position, and LIM the "current" end.
\ Most string operations operate on the substring delimited by POS and LIM, which
\ we call the active part of the string. We also keep the size of the string (the
\ real size, that is) in an ivar, so that we can get it quickly without a system
\ call.
$ D constant RET \ Carriage return character
: $ER
setFwind
cr ." size: " . ." pos: " . ." lim: " .
89 die ;
' $er -> $err
: $= { addr1 len1 addr2 len2 -- }
word0 addr1 addr2 len1 len2 pack w 10
trap$ a9ed i->l ;
: NOPEN ." (not open)" ;
:class STRING super{ handle } general
record
{ var SIZE
var POS
var LIM
int FLAGS
}
:m COPYTO: \ Redefinition of COPYTO: which will disallow a size change
\ on the copy. I found it was fairly easy to do this
\ accidentally, and get into random crash territory.
copyto: super
1 put: flags ;m
:m MARK_ORIGINAL:
\ Overrides the above check. Marks a copy as original, so we can change its
\ size. We hope we know what we're doing. At least this is a long name
\ which could hardly get typed by accident!!
clear: flags ;m
:m HANDLE: \ this method returns the handle - replaces get: in super
inline{ obj @}
^base @ ;m
:m POS: \ ( -- pos )
inline{ get: pos}
get: pos ;m
:m >POS: \ ( newpos -- )
inline{ put: pos}
put: pos ;m
:m LIM: \ ( -- lim )
inline{ get: lim}
get: lim ;m
:m >LIM: \ ( newlim -- )
inline{ put: lim}
put: lim ;m
:m LEN: \ ( -- length )
get: lim get: pos - ;m
:m >LEN: \ ( newlength -- )
get: pos + put: lim ;m
:m SKIP: \ ( n -- ) Increments POS by n.
inline{ +: pos}
+: pos ;m
:m MORE: \ ( n -- ) Increments LIM by n.
inline{ +: lim}
+: lim ;m
:m START: \ Sets POS to 0 (the start of the string).
inline{ clear: pos}
clear: pos ;m
:m BEGIN: \ Sets POS and LIM to 0, ready to begin some operation.
clear: pos clear: lim ;m
:m END: \ Sets POS and LIM to the end of the string.
get: size dup put: pos put: lim ;m
:m NOLIM: \ Sets LIM to the end of the string.
inline{ get: size put: lim}
get: size put: lim ;m
:m RESET: \ Sets POS to 0, and LIM to the end.
inline{ clear: pos get: size put: lim}
clear: pos get: size put: lim ;m
:m STEP: \ Steps down the string, by setting POS to LIM and
\ then setting LIM to the end.
get: lim put: pos get: size put: lim ;m
:m <STEP: \ Backward step. Sets LIM to POS, then POS to 0.
get: pos put: lim clear: pos ;m
:m NEW:
0 new: super
clear: size clear: pos clear: lim clear: flags ;m
:m ?NEW:
^base @ nilH <> ?EXIT new: self ;m
:m SIZE: \ ( -- size )
inline{ get: size}
get: size ;m
:m SETSIZE: \ ( newsize -- )
get: flags ?error 94 \ Can't do that on a string copy
?new: self
dup setsize: super put: size reset: self ;m
:m CLEAR:
?new: self 0 setsize: self ;m
:m GET: \ ( -- addr len ). Gets the active part of the string.
$chk
ptr: self get: pos + get: lim get: pos - ;m
:m ALL: \ ( -- addr len ) Gets all the string, ignoring POS and LIM.
ptr: self size: self ;m
:m 1ST: \ ( -- c ) Returns the char at POS.
ptr: self get: pos + c@ ;m
:m ^1ST: \ ( -- addr ) Returns the addr of the char at POS.
ptr: self get: pos + ;m
private
:m MUNGER: { addr1 len1 addr2 len2 -- offs }
\ Interface to the Toolbox Munger utility
$chk
get: flags ?error 94 \ Can't do that on a string copy
0 \ For returned result
^base @ get: pos
addr1 len1 addr2 len2
trap$ a9e0 \ call Munger
size: super put: size ;m
public
:m UC: \ ( -- addr len ) Converts string to upper case and gets it.
get: self 2dup upper ;m
:m PUT: { addr len -- }
\ Replaces entire string with replacement string. Does NEW:
\ if not already done.
?new: self clear: pos
0 -1 addr len munger: self put: lim ;m
:m ->: { str \ state -- }
\ Replaces self with the active part of string str. We assume
\ the type, and early bind. As the replacement may cause the
\ Mem Manager to move things, we lock str for the duration.
str getState: string -> state str lock: string
str get: string put: self
state str setState: string ;m
:m INSERT: { addr len -- }
?new: self
addr 0 addr len munger: self put: pos
len +: lim ;m
:m $INSERT: { str \ state -- }
\ Inserts the active text from the given relocatable
\ string, using early binding. As the memory manager could
\ move the source string to make room for the increase in
\ length of SELF, we lock the source string for the
\ operation, then restore its previous state.
str getState: string -> state str lock: string
str get: string insert: self
state str setState: string ;m
:m ADD: { addr len -- }
end: self
addr len insert: self ;m
:m $ADD: { str \ state -- }
str getState: string -> state str lock: string
str get: string add: self
state str setState: string ;m
:m +: \ ( char -- ) Appends a char to end of string
pad c! pad 1 add: self ;m
:m PRINT:
nil?: self
if Nopen else get: self type then ;m
\ :m =: { theobj -- }
\ \ Assigns this string to any object that accepts ( addr len )
\ get: self put: theobj ;m
:m FILL: \ ( c -- )
get: self rot fill ;m
\ SEARCH: and CHSEARCH: are somewhat interim. Class String+ provides more
\ efficient versions which also include case handling. But these versions
\ are short, and may be adequate for many needs.
:m SEARCH: \ ( addr len -- b )
0 0 munger: self
dup 0< if drop false else put: lim true then ;m
:m CHSEARCH: \ ( c -- b )
pad c! pad 1 search: self ;m
:m DUMP: { \ offs svCurs -- }
nil?: self if Nopen EXIT THEN
curs -> svCurs -curs
all: self swap .h .h 5 spaces
." pos: " pos: self .h 2 spaces
." lim: " lim: self .h cr
pos: self 5 - 0 max -> offs
all: self swap offs + swap offs - 80 min bounds
DO i c@ bl 126 within?
NIF ret = IF $ A6 ELSE $ D7 THEN
THEN
emit
LOOP cr
pos: self offs - spaces & P emit cr
lim: self offs -
dup 80 < IF spaces & L emit ELSE drop THEN
^1st: self len: self 0 max $ 140 min dump
svCurs -> curs ;m
:m RD: reset: self dump: self ;m \ Handy, and short to type!
;class
<" Files
+echo
: q db
temp{ string s }
" hello" put: s
dump: s ;